home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclUnixInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  8.3 KB  |  318 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclUnixInit.c --
  3.  *
  4.  *    Contains the Unix-specific interpreter initialization functions.
  5.  *
  6.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tclUnixInit.c 1.26 97/08/05 20:09:25
  12.  */
  13.  
  14. #include "tclInt.h"
  15. #include "tclPort.h"
  16. #if defined(__FreeBSD__)
  17. #   include <floatingpoint.h>
  18. #endif
  19. #if defined(__bsdi__)
  20. #   include <sys/param.h>
  21. #   if _BSDI_VERSION > 199501
  22. #    include <dlfcn.h>
  23. #   endif
  24. #endif
  25.  
  26. /*
  27.  * Default directory in which to look for Tcl library scripts.  The
  28.  * symbol is defined by Makefile.
  29.  */
  30.  
  31. static char defaultLibraryDir[200] = TCL_LIBRARY;
  32.  
  33. /*
  34.  * Directory in which to look for packages (each package is typically
  35.  * installed as a subdirectory of this directory).  The symbol is
  36.  * defined by Makefile.
  37.  */
  38.  
  39. static char pkgPath[200] = TCL_PACKAGE_PATH;
  40.  
  41. /*
  42.  * Is this module initialized?
  43.  */
  44.  
  45. static int initialized = 0;
  46.  
  47. /*
  48.  * The following string is the startup script executed in new
  49.  * interpreters.  It looks on disk in several different directories
  50.  * for a script "init.tcl" that is compatible with this version
  51.  * of Tcl.  The init.tcl script does all of the real work of
  52.  * initialization.
  53.  */
  54.  
  55. static char initScript[] =
  56. "proc tclInit {} {\n\
  57.     global tcl_library tcl_version tcl_patchLevel env errorInfo\n\
  58.     global tcl_pkgPath\n\
  59.     rename tclInit {}\n\
  60.     set errors {}\n\
  61.     set dirs {}\n\
  62.     if [info exists env(TCL_LIBRARY)] {\n\
  63.     lappend dirs $env(TCL_LIBRARY)\n\
  64.     }\n\
  65.     lappend dirs [info library]\n\
  66.     set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
  67.     lappend dirs $parentDir/lib/tcl$tcl_version\n\
  68.     if [string match {*[ab]*} $tcl_patchLevel] {\n\
  69.     set lib tcl$tcl_patchLevel\n\
  70.     } else {\n\
  71.     set lib tcl$tcl_version\n\
  72.     }\n\
  73.     lappend dirs [file dirname $parentDir]/$lib/library\n\
  74.     lappend dirs $parentDir/library\n\
  75.     foreach i $dirs {\n\
  76.     set tcl_library $i\n\
  77.     set tclfile [file join $i init.tcl]\n\
  78.     if {[file exists $tclfile]} {\n\
  79.             lappend tcl_pkgPath [file dirname $i]\n\
  80.         if ![catch {uplevel #0 [list source $tclfile]} msg] {\n\
  81.         return\n\
  82.         } else {\n\
  83.         append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
  84.         }\n\
  85.     }\n\
  86.     }\n\
  87.     set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
  88.     append msg \"    $dirs\n\n\"\n\
  89.     append msg \"$errors\n\n\"\n\
  90.     append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
  91.     error $msg\n\
  92. }\n\
  93. tclInit";
  94.  
  95. /*
  96.  * Static routines in this file:
  97.  */
  98.  
  99. static void    PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));
  100.  
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * PlatformInitExitHandler --
  105.  *
  106.  *    Uninitializes all values on unload, so that this module can
  107.  *    be later reinitialized.
  108.  *
  109.  * Results:
  110.  *    None.
  111.  *
  112.  * Side effects:
  113.  *    Returns the module to uninitialized state.
  114.  *
  115.  *----------------------------------------------------------------------
  116.  */
  117.  
  118. static void
  119. PlatformInitExitHandler(clientData)
  120.     ClientData clientData;        /* Unused. */
  121. {
  122.     strcpy(defaultLibraryDir, TCL_LIBRARY);
  123.     strcpy(pkgPath, TCL_PACKAGE_PATH);
  124.     initialized = 0;
  125. }
  126.  
  127. /*
  128.  *----------------------------------------------------------------------
  129.  *
  130.  * TclPlatformInit --
  131.  *
  132.  *    Performs Unix-specific interpreter initialization related to the
  133.  *      tcl_library and tcl_platform variables, and other platform-
  134.  *    specific things.
  135.  *
  136.  * Results:
  137.  *    None.
  138.  *
  139.  * Side effects:
  140.  *    Sets "tcl_library" and "tcl_platform" Tcl variables.
  141.  *
  142.  *----------------------------------------------------------------------
  143.  */
  144.  
  145. void
  146. TclPlatformInit(interp)
  147.     Tcl_Interp *interp;
  148. {
  149. #ifndef NO_UNAME
  150.     struct utsname name;
  151. #endif
  152.     int unameOK;
  153.  
  154.     tclPlatform = TCL_PLATFORM_UNIX;
  155.     Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
  156.     Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
  157.     Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
  158.     unameOK = 0;
  159. #ifndef NO_UNAME
  160.     if (uname(&name) >= 0) {
  161.     unameOK = 1;
  162.     Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
  163.         TCL_GLOBAL_ONLY);
  164.     /*
  165.      * The following code is a special hack to handle differences in
  166.      * the way version information is returned by uname.  On most
  167.      * systems the full version number is available in name.release.
  168.      * However, under AIX the major version number is in
  169.      * name.version and the minor version number is in name.release.
  170.      */
  171.  
  172.     if ((strchr(name.release, '.') != NULL) || !isdigit(name.version[0])) {
  173.         Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
  174.             TCL_GLOBAL_ONLY);
  175.     } else {
  176.         Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
  177.             TCL_GLOBAL_ONLY);
  178.         Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
  179.             TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  180.         Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
  181.             TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  182.     }
  183.     Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
  184.         TCL_GLOBAL_ONLY);
  185.     }
  186. #endif
  187.     if (!unameOK) {
  188.     Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
  189.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
  190.     Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
  191.     }
  192.  
  193.     if (!initialized) {
  194.  
  195.         /*
  196.          * Create an exit handler so that uninitialization will be done
  197.          * on unload.
  198.          */
  199.         
  200.         Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
  201.         
  202.     /*
  203.      * The code below causes SIGPIPE (broken pipe) errors to
  204.      * be ignored.  This is needed so that Tcl processes don't
  205.      * die if they create child processes (e.g. using "exec" or
  206.      * "open") that terminate prematurely.  The signal handler
  207.      * is only set up when the first interpreter is created;
  208.      * after this the application can override the handler with
  209.      * a different one of its own, if it wants.
  210.      */
  211.     
  212. #ifdef SIGPIPE
  213.     (void) signal(SIGPIPE, SIG_IGN);
  214. #endif /* SIGPIPE */
  215.  
  216. #ifdef __FreeBSD__
  217.     fpsetround(FP_RN);
  218.     fpsetmask(0L);
  219. #endif
  220.  
  221. #if defined(__bsdi__) && (_BSDI_VERSION > 199501)
  222.     /*
  223.      * Find local symbols. Don't report an error if we fail.
  224.      */
  225.     (void) dlopen (NULL, RTLD_NOW);
  226. #endif
  227.     initialized = 1;
  228.     }
  229. }
  230.  
  231. /*
  232.  *----------------------------------------------------------------------
  233.  *
  234.  * Tcl_Init --
  235.  *
  236.  *    This procedure is typically invoked by Tcl_AppInit procedures
  237.  *    to perform additional initialization for a Tcl interpreter,
  238.  *    such as sourcing the "init.tcl" script.
  239.  *
  240.  * Results:
  241.  *    Returns a standard Tcl completion code and sets interp->result
  242.  *    if there is an error.
  243.  *
  244.  * Side effects:
  245.  *    Depends on what's in the init.tcl script.
  246.  *
  247.  *----------------------------------------------------------------------
  248.  */
  249.  
  250. int
  251. Tcl_Init(interp)
  252.     Tcl_Interp *interp;        /* Interpreter to initialize. */
  253. {
  254.     return Tcl_Eval(interp, initScript);
  255. }
  256.  
  257. /*
  258.  *----------------------------------------------------------------------
  259.  *
  260.  * Tcl_SourceRCFile --
  261.  *
  262.  *    This procedure is typically invoked by Tcl_Main of Tk_Main
  263.  *    procedure to source an application specific rc file into the
  264.  *    interpreter at startup time.
  265.  *
  266.  * Results:
  267.  *    None.
  268.  *
  269.  * Side effects:
  270.  *    Depends on what's in the rc script.
  271.  *
  272.  *----------------------------------------------------------------------
  273.  */
  274.  
  275. void
  276. Tcl_SourceRCFile(interp)
  277.     Tcl_Interp *interp;        /* Interpreter to source rc file into. */
  278. {
  279.     Tcl_DString temp;
  280.     char *fileName;
  281.     Tcl_Channel errChannel;
  282.  
  283.     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
  284.  
  285.     if (fileName != NULL) {
  286.         Tcl_Channel c;
  287.     char *fullName;
  288.  
  289.         Tcl_DStringInit(&temp);
  290.     fullName = Tcl_TranslateFileName(interp, fileName, &temp);
  291.     if (fullName == NULL) {
  292.         /*
  293.          * Couldn't translate the file name (e.g. it referred to a
  294.          * bogus user or there was no HOME environment variable).
  295.          * Just do nothing.
  296.          */
  297.     } else {
  298.  
  299.         /*
  300.          * Test for the existence of the rc file before trying to read it.
  301.          */
  302.  
  303.             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
  304.             if (c != (Tcl_Channel) NULL) {
  305.                 Tcl_Close(NULL, c);
  306.         if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
  307.             errChannel = Tcl_GetStdChannel(TCL_STDERR);
  308.             if (errChannel) {
  309.             Tcl_Write(errChannel, interp->result, -1);
  310.             Tcl_Write(errChannel, "\n", 1);
  311.             }
  312.         }
  313.         }
  314.     }
  315.         Tcl_DStringFree(&temp);
  316.     }
  317. }
  318.